perm filename DDFAI.FAI[S,HE] blob
sn#512620 filedate 1982-05-21 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00040 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 universal stuff
C00006 00003 title letters
C00013 00004 title dotlet
C00022 00005 title BIG polygon
C00023 00006
C00028 00007 title polygon
C00030 00008
C00035 00009 TITLE POLYAR
C00036 00010 TITLE DDSTUF
C00039 00011 BITUP MIDI
C00040 00012 HORUP
C00042 00013 VERUP
C00044 00014 OBLUP
C00046 00015 RECTUP
C00048 00016 SCREEN SCREEM BEGINNING OF SAIL INTERFACE
C00050 00017 DOT
C00051 00018 PPPOS
C00052 00019 LINE LINET
C00054 00020 LITEN DRKEN INVEN DPYUP ERASE DDINIT
C00058 00021 GDDCHN RDDCHN
C00060 00022 SHOW SHOWA SHOWS
C00063 00023 LINSCH SCNOFF
C00067 00024 RECTAN
C00068 00025 ELLIPS
C00070 00026 DDOR DDAND DDEXCH
C00072 00027 TITLE XGPUP converts the DD buffer into XGP format and
C00073 00028 SMAL
C00075 00029 BIG
C00078 00030 BIGER
C00081 00031 BIGEST
C00083 00032 BIGFAT
C00085 00033 PACKED
C00087 00034 FINSH: PUSH THIS,[424000,,0]
C00089 00035 title synmap
C00095 00036 synmap
C00096 00037 vitout
C00098 00038 mapset
C00100 00039 PJUP
C00103 00040 TITLE DDPAK
C00105 ENDMK
C⊗;
universal stuff
define liotm(adr) <jrst 2,@[adr]>
define params(a1,a2,a3,a4,a5,a6,a7)
{ifdif <a1><><iii←←1
ifdif <a2><><iii←←2
ifdif <a3><><iii←←3
ifdif <a4><><iii←←4
ifdif <a5><><iii←←5
ifdif <a6><><iii←←6
ifdif <a7><><iii←←7>>>>>>>
move a1,-iii(p)
pop p,-iii(p)
ifdif <a7><><pop p,a7>
ifdif <a6><><pop p,a6>
ifdif <a5><><pop p,a5>
ifdif <a4><><pop p,a4>
ifdif <a3><><pop p,a3>
ifdif <a2><><pop p,a2>
}
;cono bits for elf
SETADR←←400000 ;If 1, set address from bits 19:35.
;If 0, the other bits have these meanings:
pwrfai←←200000 ;
IRESET←←100000 ;Reset the interface
CLRINT←←40000 ;Clear the interrupt conditions
IGNPAR←←20000 ;Ignore parity on input
STOPIT←←10000 ;Stop data transfers
DOIT←←4000 ;Start data transfers
WRITE←←2000 ;0 ⊃ read, 1 ⊃ write
GRAB←←1000 ;Don't let go of the bus
SGNEXT←←400 ;Extend sign of inputs
; Data packing mode:
ONEWD←←0 ;16 bits right-adjusted in a word
TWOWD←←100 ;16 bits right-adj in each halfword
TWOWDR←←200 ;32 bits right-adjusted
TWOWDL←←300 ;32 bits left-adjusted
;coni bits
IREQ←←400000 ;The 11 requested an interrupt
ADRERR←←200000 ;ADRS ERR from a console operation
;(set by software, not a CONI)
NXM11←←100000 ;No response to the address from the bus
BUSTO←←40000 ;Couldn't get the bus
BINIT←←20000 ;BUS INIT in progress
PARBAD←←10000 ;Bad parity
BUSY←←4000 ;Working on it
DONE←←2000 ;This causes a Data Transfer interrupt.
prgend
title letters
entry LETAB
;LETTER TABLE
LETAB: 770000000000↔0↔0 ;null
022042702026↔770000000000↔0 ;↓
402414030110↔204477000000↔0 ;α
001526364544↔234241302012↔770000000000 ;β
012541770000↔0↔0 ;∧
034342770000↔0↔0 ;¬
443413021130↔407002327700↔0 ;ε
031434457014↔107030347700↔0 ;π
002370401506↔770000000000↔0 ;λ
0↔0↔0 ;tab
0↔0↔0 ;lf
0↔0↔0 ;vt
0↔0↔0 ;ff
0↔0↔0 ;cr
110204153142↔443511770000↔0 ;∞
263542413010↔010213334277↔0 ;∂
411102041545↔770000000000↔0 ;⊂
013142443505↔770000000000↔0 ;⊃
010415354441↔770000000000↔0 ;∩
050211314245↔770000000000↔0 ;∪
062046701333↔770000000000↔0 ;∀
004046067013↔437700000000↔0 ;∃
032543210370↔123470321477↔0 ;⊗
120314703243↔347003437700↔0 ;↔
074777000000↔0↔0 ;_
034370214325↔770000000000↔0 ;→
031432437700↔0↔0 ;~
044470024270↔113577000000↔0 ;≠
024170420344↔770000000000↔0 ;≤
044302700142↔770000000000↔0 ;≥
044470034370↔024277000000↔0 ;≡
052145770000↔0↔0 ;∨
770000000000↔0↔0 ;space
202070222677↔0↔0 ;!
141670242677↔0↔0 ;"
101670303670↔024270044477↔0 ;#
202670021131↔423313041535↔447700000000 ;$
004670142425↔151470213132↔222177000000 ;%
401526350220↔427700000000↔0 ;&
143677000000↔0↔0 ;'
403123354677↔0↔0 ;(
001123150677↔0↔0 ;)
014570054170↔212570034377↔0 ;*
034370212577↔0↔0 ;+
273177000000↔0↔0 ;,
034377000000↔0↔0 ;-
202177000000↔0↔0 ;.
004677000000↔0↔0 ;/
051636454130↔100105700046↔770000000000 ;0
103070202615↔770000000000↔0 ;1
051636454433↔020040770000↔0 ;2
051636454433↔424130100177↔0 ;3
303602427700↔0↔0 ;4
011030414233↔030646770000↔0 ;5
453616050110↔304142331302↔770000000000 ;6
204606770000↔0↔0 ;7
130405163645↔443342413010↔010213337700 ;8
011030414536↔160504133344↔770000000000 ;9
202170242577↔0↔0 ;:
172170242577↔0↔0 ;;
400346770000↔0↔0 ;<
024270044477↔0↔0 ;=
004306770000↔0↔0 ;>
051636454422↔217027277700↔0 ;?
424130100105↔163645443222↔241412237700 ;@
002640701232↔770000000000↔0 ;A
033344360600↔304233770000↔0 ;B
413010010516↔364577000000↔0 ;C
000636444230↔007700000000↔0 ;D
400006467003↔337700000000↔0 ;E
000646700333↔770000000000↔0 ;F
324241301001↔051636457700↔0 ;G
000670404670↔034377000000↔0 ;H
103070202670↔163677000000↔0 ;I
021030414677↔0↔0 ;J
000670024670↔402477000000↔0 ;K
060040770000↔0↔0 ;L
000624464077↔0↔0 ;M
000640467700↔0↔0 ;N
010516364541↔301001770000↔0 ;O
000636454433↔037700000000↔0 ;P
010516364541↔301001703140↔770000000000 ;Q
000636454433↔037023407700↔0 ;R
011030414233↔130405163645↔770000000000 ;S
202670064677↔0↔0 ;T
060110304146↔770000000000↔0 ;U
062046770000↔0↔0 ;V
060023404677↔0↔0 ;W
004670400677↔0↔0 ;X
202306702346↔770000000000↔0 ;Y
064600407700↔0↔0 ;Z
402026467700↔0↔0 ;[
400677000000↔0↔0 ;\
002026067700↔0↔0 ;]
202670042644↔770000000000↔0 ;↑
034370210325↔770000000000↔0 ;←
341677000000↔0↔0 ;`
031434434070↔413212011030↔417700000000 ;a
000670011030↔414334140377↔0 ;b
433414030110↔304177000000↔0 ;c
404670413010↔010314344377↔0 ;d
413010010314↔344202770000↔0 ;e
101526364570↔032377000000↔0 ;f
173740433414↔030110304177↔0 ;g
000670031434↔434077000000↔0 ;h
202470252577↔0↔0 ;i
001737404470↔454577000000↔0 ;j
000670024470↔402377000000↔0 ;k
202677000000↔0↔0 ;l
000470031423↔207023344340↔770000000000 ;m
000470031434↔434077000000↔0 ;n
100103143443↔413010770000↔0 ;o
070470031434↔434130100177↔0 ;p
474334140301↔103041770000↔0 ;q
000470031434↔437700000000↔0 ;r
011030413212↔031434437700↔0 ;s
151120304170↔043477000000↔0 ;t
404470040110↔304177000000↔0 ;u
042044770000↔0↔0 ;v
040022404477↔0↔0 ;w
004470044077↔0↔0 ;x
041221700732↔447700000000↔0 ;y
044400407700↔0↔0 ;z
403132233435↔467700000000↔0 ;{
202677000000↔0↔0 ;|
201203142634↔433220770000↔0 ;alt (quad)
001112231415↔067700000000↔0 ;}
PRGEND
title dotlet
entry DOTLET
;DOT LETTER TABLE
DOTLET: 000000000000↔000000000000 ;null
001010101052↔341000000000 ;↓
000000324444↔443200000000 ;α
000000344274↔427440400000 ;β
000000102442↔000000000000 ;∧
000000007602↔000000000000 ;¬
000000142034↔201400000000 ;ε
000000762424↔242400000000 ;π
000040402010↔244200000000 ;λ
702020200014↔121412140000 ;tab
404040700016↔101410000000 ;lf
000412101010↔105020000000 ;vt
001010761010↔760000000000 ;ff
344040340034↔223422220000 ;cr
000000245252↔240000000000 ;∞
003004023642↔423400000000 ;∂
000036404040↔360000000000 ;⊂
000074020202↔740000000000 ;⊃
000034424242↔000000000000 ;∩
000042424234↔000000000000 ;∪
004242764224↔241000000000 ;∀
007602023602↔027600000000 ;∃
000034665266↔340000000000 ;⊗
001004760410↔207620100000 ;↔
000000000000↔000000760000 ;_
000010047604↔100000000000 ;→
325400000000↔000000000000 ;~
000204761076↔204000000000 ;≠
000410201004↔003400000000 ;≤
002010041020↔003400000000 ;≥
000076007600↔760000000000 ;≡
000000422410↔000000000000 ;∨
000000000000↔000000000000 ;space
001010101010↔001000000000 ;!
242424000000↔000000000000 ;"
000024762424↔762400000000 ;#
103452503412↔523410000000 ;$
007662041020↔464600000000 ;%
002050502052↔443200000000 ;&
303060000000↔000000000000 ;'
000204101010↔040200000000 ;(
004020101010↔204000000000 ;)
001052341034↔521000000000 ;*
000010107610↔100000000000 ;+
000000000000↔303060000000 ;,
000000007600↔000000000000 ;-
000000000000↔303000000000 ;.
000002041020↔400000000000 ;/
003442465262↔423400000000 ;0
001030101010↔103400000000 ;1
003442020410↔207600000000 ;2
003442021402↔423400000000 ;3
000414244476↔040400000000 ;4
007640740202↔423400000000 ;5
001420407442↔423400000000 ;6
007602040410↔101000000000 ;7
003442423442↔423400000000 ;8
003442423602↔043000000000 ;9
000000303000↔303000000000 ;:
000000303000↔303060000000 ;;
000004102010↔040000000000 ;<
000000760076↔000000000000 ;=
000020100410↔200000000000 ;>
003442041010↔001000000000 ;?
003442565256↔403400000000 ;@
003442427642↔424200000000 ;A
007442427442↔427400000000 ;B
003442404040↔423400000000 ;C
007422222222↔227400000000 ;D
007640407440↔407600000000 ;E
007640407440↔404000000000 ;F
003442404046↔423400000000 ;G
004242427642↔424200000000 ;H
003410101010↔103400000000 ;I
000202020202↔423400000000 ;J
004244506050↔444200000000 ;K
004040404040↔407600000000 ;L
004266524242↔424200000000 ;M
004242625246↔424200000000 ;N
003442424242↔423400000000 ;O
007442427440↔404000000000 ;P
003442424252↔443200000000 ;Q
007442427450↔444200000000 ;R
003442403402↔423400000000 ;S
007610101010↔101000000000 ;T
004242424242↔423400000000 ;U
004242424224↔241000000000 ;V
004242424252↔664200000000 ;W
004242241024↔424200000000 ;X
004242241010↔101000000000 ;Y
007602047620↔407600000000 ;Z
161010101010↔101016000000 ;[
000040201004↔020000000000 ;\
701010101010↔101070000000 ;]
001034521010↔101000000000 ;↑
000010207620↔100000000000 ;←
141406000000↔000000000000 ;`
000000340236↔423600000000 ;a
004040744242↔427400000000 ;b
000000344240↔403600000000 ;c
000202364242↔423600000000 ;d
000000344274↔403400000000 ;e
001422207020↔202000000000 ;f
000000344242↔423602340000 ;g
004040744242↔424200000000 ;h
000010001010↔101000000000 ;i
000002000202↔020242340000 ;j
004040424470↔444200000000 ;k
001010101010↔101000000000 ;l
000000645252↔525200000000 ;m
000000546242↔424200000000 ;n
000000344242↔423400000000 ;o
000000744242↔427440400000 ;p
000000344242↔423602020000 ;q
000000546240↔404000000000 ;r
000000364034↔027400000000 ;s
001010761010↔100600000000 ;t
000000424242↔423400000000 ;u
000000424242↔241000000000 ;v
000000424252↔522400000000 ;w
000000422410↔244200000000 ;x
000000424242↔241020400000 ;y
000000760434↔207600000000 ;z
020404041004↔040402000000 ;{
101010101010↔101010100000 ;|
402020201020↔202040000000 ;alt (quad)
001010244224↔101000000000 ;}
777777777777↔777777770000 ;
003642423612↔224200000000 ;
000000364236↔224200000000 ;
003442027602↔423400000000 ;
000000344216↔421600000000 ;
004242423602↔020200000000 ;
000000424236↔020200000000 ;
004452527252↔524400000000 ;
000000445272↔524400000000 ;
005252525252↔527600000000 ;
000000525252↔527600000000 ;
005252525252↔527606000000 ;
000000525252↔527606000000 ;
004242424242↔427606000000 ;
000000424242↔427606000000 ;
007622222242↔424200000000 ;
000000762222↔424200000000 ;
000000606034↔223400000000 ;
004242427246↔467200000000 ;
000000424272↔467200000000 ;
004242465262↔424200000000 ;
000000424652↔624200000000 ;
340042424652↔624200000000 ;
003400424652↔624200000000 ;
007642404040↔404000000000 ;
000000764240↔404000000000 ;
007622222242↔427642000000 ;
000000762222↔427642000000 ;
000000404074↔427400000000 ;
005252523452↔525200000000 ;
000000525234↔525200000000 ;
007440407442↔427400000000 ;
000000344074↔427400000000 ;
003410344234↔103400000000 ;
000010103442↔341010000000 ;
007402027602↔027600000000 ;
000000740276↔027400000000 ;
247640407440↔407600000000 ;
002400344274↔403400000000 ;
000000744274↔427400000000 ;
007624242424↔242400000000 ;
000000424276↔424200000000 ;
000000445060↔504400000000 ;
PRGEND
title BIG polygon
entry polygx
; OPDEF FIX[247000233000]
define fix(x)<kifix x,x>
x1←1 y1←2 x2←3 y2←4 P←17 N←←1 I←←7 J←←5 T←←6 II←←12 JJ←←14 TT←←15 TTT←←16
POLYGX: movem 12,ac12# ;FILL IN AN N SIDED POLYGON
movem 16,ac16#
POP P,RETAD↑ ; POLYGO(N,X,Y)
POP P,Y2 ; X AND Y ARE SINGLY SUBSCRIPED ARRAYS
POP P,X2
POP P,N
HRRZ T,N
MOVE N,T
LFL: MOVE TT,(X2)
FSBR TT,XL↑
FMPR TT,XSC↑
FIX TT,
MOVEM TT,PX(T)
MOVE TT,(Y2)
FSBR TT,YH↑
FMPR TT,YSC↑
FIX TT,
MOVEM TT,PY(T)
ADDI X2,1
ADDI Y2,1
SOJG T,LFL
JSR POLYUP
move 12,ac12
move 16,ac16
JRST @RETAD
PX: 0
BLOCK 10000
PY: 0
BLOCK 10000
RNK: 0
BLOCK 10000
DXS: 0
BLOCK 10000
NS: 0
BLOCK 10000
LOUT: BLOCK 10000
LXS: 377777777777
BLOCK 10000
SAVN: 0
POLYUP: 0 ;ROUTINE TO FILL IN A POLYGON
MOVEM N,SAVN
MOVEI I,1
MOVEM I,RNK+1 ;PHASE 1, GENERATE AN
ILOP: AOS II,I ;INVERSE RANKING
MOVE T,PY(I) ;KEYED ON Y VALUES
MOVEI J,1
JLOP: MOVE JJ,RNK(J)
CAML T,PY(JJ)
JRST NOXCH
EXCH II,RNK(J)
MOVE T,PY(II)
NOXCH: CAIGE J,-1(I)
AOJA J,JLOP
MOVEM II,RNK(I)
CAMGE I,N
JRST ILOP
MOVE T,PX+1
MOVEM T,PX+1(N)
MOVE T,PY+1
MOVEM T,PY+1(N)
MOVE T,PX(N)
MOVEM T,PX
MOVE T,PY(N)
MOVEM T,PY
MOVEI I,1
MOVEI J,0
MOVE II,RNK(I)
MOVE Y1,PY(II)
NEWPNT: HRLZ X1,PX(II)
MOVE T,PY-1(II)
SUB T,Y1
JUMPLE T,TRYLOW+1 ;FORGET IT IF THIS EDGE POINTS
SKIPG JJ,J ;UPWARDS
JRST HINS
HILP: CAMG X1,LXS(JJ)
JRST HINS
MOVE TT,LXS(JJ)
MOVEM TT,LXS+1(JJ)
MOVE TT,DXS(JJ)
MOVEM TT,DXS+1(JJ)
MOVE TT,NS(JJ)
MOVEM TT,NS+1(JJ)
SOJG JJ,HILP
HINS: MOVEM T,NS+1(JJ) ;INSERT LINE SEGS
MOVEM X1,LXS+1(JJ) ;COMING INTO THE SCANLINE
HLRE X1,X1
SUB X1,PX-1(II)
HRLZ X2,X1
HRRI X1,400000
ADD X2,X1
IDIVI X2,1(T)
MOVNM X2,DXS+1(JJ)
ADDI J,1
TRYLOW: HRLZ X1,PX(II)
MOVE T,PY+1(II)
SUB T,Y1
JUMPL T,DRAWG ;IF THIS EDGE POINTS
SKIPG JJ,J ;UPWARDS, TIME TO DRAW
JRST LINS
LILP: CAMG X1,LXS(JJ)
JRST LINS
MOVE TT,LXS(JJ)
MOVEM TT,LXS+1(JJ)
MOVE TT,DXS(JJ)
MOVEM TT,DXS+1(JJ)
MOVE TT,NS(JJ)
MOVEM TT,NS+1(JJ)
SOJG JJ,LILP
LINS: MOVEM T,NS+1(JJ)
MOVEM X1,LXS+1(JJ)
HLRE X1,X1
SUB X1,PX+1(II)
HRLZ X2,X1
HRRI X1,400000
ADD X2,X1
IDIVI X2,1(T)
MOVNM X2,DXS+1(JJ)
ADDI J,1
DRAWG: CAML I,SAVN
JRST DRAWM
ADDI I,1
SCNRE: MOVE II,RNK(I)
SCNR: CAMN Y1,PY(II)
JRST NEWPNT
DRAWM: MOVE JJ,J ;UPDATE EACH EDGE
SETZB T,II ;AND THEN
FLOP: MOVE X1,LXS(JJ) ;MAKE UP DRAWING LIST
MOVE X2,DXS(JJ)
ADDB X2,LXS(JJ)
JSR FILIN
SOSL NS(JJ)
TRCE T,1
JUMPE T,BLAR
MOVE X2,LXS-1(JJ)
JSR FILIN
BLAR: SOJG JJ,FLOP
DRAWZ: HRRE X1,LOUT(II) ;DRAW THIS SET
HLRE X2,LOUT(II)
pushj p,HORUP↑
SOJG II,DRAWZ
NEXL: MOVN JJ,J ;REMOVE EXPIRED SEGMNTS
HRLZ JJ,JJ ;AND MAKE POINTS SORTED
MOVEI J,0 ;AGAIN, IN PREPARATION
LPO: SKIPL NS+1(JJ) ;FOR NEXT SCANLINE
AOJA J,NELP
SLOOP: AOBJN JJ,LPO
JUMPLE J,@POLYUP
AOJA Y1,SCNRE
NELP: MOVE T,LXS+1(JJ)
MOVE TT,DXS+1(JJ)
MOVE TTT,NS+1(JJ)
MOVEI II,-1(J)
FLOOP: CAMG T,LXS(II)
JRST PFND
MOVE X1,LXS(II)
MOVEM X1,LXS+1(II)
MOVE X1,DXS(II)
MOVEM X1,DXS+1(II)
MOVE X1,NS(II)
MOVEM X1,NS+1(II)
SOJG II,FLOOP
PFND: MOVEM T,LXS+1(II)
MOVEM TT,DXS+1(II)
MOVEM TTT,NS+1(II)
AOBJN JJ,LPO
AOJA Y1,SCNRE
FILIN: 0 ;ADD A LINE SEGMENT
HLRM X1,LOUT+1(II)
HLLM X2,LOUT+1(II)
AOJA II,@FILIN
prgend
title polygon
entry polygo
EXTERN $$$PX,$$$PY,$$$RNK,$$$DXS,$$$NS,$$LOUT,$$$LXS
; OPDEF FIX[247000233000]
define fix(x)<kifix x,x>
x1←1 y1←2 x2←3 y2←4 P←17 N←←1 I←←7 J←←5 T←←6 II←←12 JJ←←14 TT←←15 TTT←←16
POLYGO: movem 12,ac12# ;FILL IN AN N SIDED POLYGON
movem 16,ac16#
POP P,RETAD↑ ; POLYGO(N,X,Y)
POP P,Y2 ; X AND Y ARE SINGLY SUBSCRIPED ARRAYS
POP P,X2
POP P,N
HRRZ T,N
MOVE N,T
LFL: MOVE TT,(X2)
FSBR TT,XL↑
FMPR TT,XSC↑
FIX TT,
MOVEM TT,$$$PX(T)
MOVE TT,(Y2)
FSBR TT,YH↑
FMPR TT,YSC↑
FIX TT,
MOVEM TT,$$$PY(T)
ADDI X2,1
ADDI Y2,1
SOJG T,LFL
JSR POLYUP
move 12,ac12
move 16,ac16
JRST @RETAD
SAVN: 0
POLYUP: 0 ;ROUTINE TO FILL IN A POLYGON
MOVEM N,SAVN
MOVEI I,1
MOVEM I,$$$RNK+1 ;PHASE 1, GENERATE AN
ILOP: AOS II,I ;INVERSE RANKING
MOVE T,$$$PY(I) ;KEYED ON Y VALUES
MOVEI J,1
JLOP: MOVE JJ,$$$RNK(J)
CAML T,$$$PY(JJ)
JRST NOXCH
EXCH II,$$$RNK(J)
MOVE T,$$$PY(II)
NOXCH: CAIGE J,-1(I)
AOJA J,JLOP
MOVEM II,$$$RNK(I)
CAMGE I,N
JRST ILOP
MOVE T,$$$PX+1
MOVEM T,$$$PX+1(N)
MOVE T,$$$PY+1
MOVEM T,$$$PY+1(N)
MOVE T,$$$PX(N)
MOVEM T,$$$PX
MOVE T,$$$PY(N)
MOVEM T,$$$PY
MOVEI I,1
MOVEI J,0
MOVE II,$$$RNK(I)
MOVE Y1,$$$PY(II)
NEWPNT: HRLZ X1,$$$PX(II)
MOVE T,$$$PY-1(II)
SUB T,Y1
JUMPLE T,TRYLOW+1 ;FORGET IT IF THIS EDGE POINTS
SKIPG JJ,J ;UPWARDS
JRST HINS
HILP: CAMG X1,$$$LXS(JJ)
JRST HINS
MOVE TT,$$$LXS(JJ)
MOVEM TT,$$$LXS+1(JJ)
MOVE TT,$$$DXS(JJ)
MOVEM TT,$$$DXS+1(JJ)
MOVE TT,$$$NS(JJ)
MOVEM TT,$$$NS+1(JJ)
SOJG JJ,HILP
HINS: MOVEM T,$$$NS+1(JJ) ;INSERT LINE SEGS
MOVEM X1,$$$LXS+1(JJ) ;COMING INTO THE SCANLINE
HLRE X1,X1
SUB X1,$$$PX-1(II)
HRLZ X2,X1
HRRI X1,400000
ADD X2,X1
IDIVI X2,1(T)
MOVNM X2,$$$DXS+1(JJ)
ADDI J,1
TRYLOW: HRLZ X1,$$$PX(II)
MOVE T,$$$PY+1(II)
SUB T,Y1
JUMPL T,DRAWG ;IF THIS EDGE POINTS
SKIPG JJ,J ;UPWARDS, TIME TO DRAW
JRST LINS
LILP: CAMG X1,$$$LXS(JJ)
JRST LINS
MOVE TT,$$$LXS(JJ)
MOVEM TT,$$$LXS+1(JJ)
MOVE TT,$$$DXS(JJ)
MOVEM TT,$$$DXS+1(JJ)
MOVE TT,$$$NS(JJ)
MOVEM TT,$$$NS+1(JJ)
SOJG JJ,LILP
LINS: MOVEM T,$$$NS+1(JJ)
MOVEM X1,$$$LXS+1(JJ)
HLRE X1,X1
SUB X1,$$$PX+1(II)
HRLZ X2,X1
HRRI X1,400000
ADD X2,X1
IDIVI X2,1(T)
MOVNM X2,$$$DXS+1(JJ)
ADDI J,1
DRAWG: CAML I,SAVN
JRST DRAWM
ADDI I,1
SCNRE: MOVE II,$$$RNK(I)
SCNR: CAMN Y1,$$$PY(II)
JRST NEWPNT
DRAWM: MOVE JJ,J ;UPDATE EACH EDGE
SETZB T,II ;AND THEN
FLOP: MOVE X1,$$$LXS(JJ) ;MAKE UP DRAWING LIST
MOVE X2,$$$DXS(JJ)
ADDB X2,$$$LXS(JJ)
JSR FILIN
SOSL $$$NS(JJ)
TRCE T,1
JUMPE T,BLAR
MOVE X2,$$$LXS-1(JJ)
JSR FILIN
BLAR: SOJG JJ,FLOP
DRAWZ: HRRE X1,$$LOUT(II) ;DRAW THIS SET
HLRE X2,$$LOUT(II)
pushj p,HORUP↑
SOJG II,DRAWZ
NEXL: MOVN JJ,J ;REMOVE EXPIRED SEGMNTS
HRLZ JJ,JJ ;AND MAKE POINTS SORTED
MOVEI J,0 ;AGAIN, IN PREPARATION
LPO: SKIPL $$$NS+1(JJ) ;FOR NEXT SCANLINE
AOJA J,NELP
SLOOP: AOBJN JJ,LPO
JUMPLE J,@POLYUP
AOJA Y1,SCNRE
NELP: MOVE T,$$$LXS+1(JJ)
MOVE TT,$$$DXS+1(JJ)
MOVE TTT,$$$NS+1(JJ)
MOVEI II,-1(J)
FLOOP: CAMG T,$$$LXS(II)
JRST PFND
MOVE X1,$$$LXS(II)
MOVEM X1,$$$LXS+1(II)
MOVE X1,$$$DXS(II)
MOVEM X1,$$$DXS+1(II)
MOVE X1,$$$NS(II)
MOVEM X1,$$$NS+1(II)
SOJG II,FLOOP
PFND: MOVEM T,$$$LXS+1(II)
MOVEM TT,$$$DXS+1(II)
MOVEM TTT,$$$NS+1(II)
AOBJN JJ,LPO
AOJA Y1,SCNRE
FILIN: 0 ;ADD A LINE SEGMENT
HLRM X1,$$LOUT+1(II)
HLLM X2,$$LOUT+1(II)
AOJA II,@FILIN
prgend
TITLE POLYAR
ENTRY $$$PX,$$$PY,$$$RNK,$$$DXS,$$$NS,$$LOUT,$$$LXS
$$$PX: 0
BLOCK 300
$$$PY: 0
BLOCK 300
$$$RNK: 0
BLOCK 300
$$$DXS: 0
BLOCK 300
$$$NS: 0
BLOCK 300
$$LOUT: BLOCK 300
$$$LXS: 377777777777
BLOCK 300
PRGEND
TITLE DDSTUF
ENTRY XL,YH,XSC,YSC,DBUF,SLINE,BSK,RETAD,MIDI,DDGO
ENTRY SCREEN,SCREEM,LINE,LITEN,DRKEN,INVEN,DPYUP,DDINIT,ELLIPS
ENTRY ERASE
ENTRY GDDCHN,RDDCHN,LINSCN,MAPSCN,SCNOFF,SCNFRZ,SCNINC,RECTAN,DOT
ENTRY SHOW,SHOWA,SHOWS,DDOR,DDAND,DDEXCH
entry oblup,horup,verup,horupo,verupo
ENTRY PPPOS,LINET
search stuff
define fix(x)<kifix x,x>
DEFINE FLOAT(N) <FLTR N,N>
xhi←←20*40-2 ↔ yhi←←740
THK: 0
INC: 3
XINC: 1
SLINE: BLOCK 741
DBUF: 016034071114 ; dark background, write enable, graphic mode (3 times)
074170362224 ; select chan 30 (3 times) THIS IS MODIFIED to actual chan.
BLOCK 22*740+50
DDGO: DBUF
0
0
0
QUAD←←1 ↔ X1←1
LINUM←←2 ↔ Y1←2
DBLOC←←3 ↔ X2←3
TEMP←←4 ↔ Y2←4
XA←11
XB←13
p←17
cpopj: popj p,
BUFUP: 0 ;ROUTINE FOR CREATING RAW DD BUFFER
MOVE TEMP,[016034071114] ; set dark background, write enb, graphix
MOVEM TEMP,DBUF
MOVE TEMP,[074170362224] ; set channel selection to chan 30
MOVEM TEMP,DBUF+1
MOVEI QUAD,0 ;WHICH QUARTER
MOVEI DBLOC,3 ;WHERE IN DBUF
LPQUA: MOVE LINUM,QUAD ;LINE NUMBER
LPLIN: MOVE TEMP,DBLOC
MOVEM TEMP,SLINE(LINUM)
MOVE TEMP,LINUM
MOVEI 5,0
LSHC TEMP,-4
ORI TEMP,400
LSH TEMP,4
LSHC TEMP,20
ORI TEMP,3454 ; col. select, hi line addr, lo line addr.
MOVEM TEMP,DBUF-1(DBLOC)
MOVEI TEMP,2
MOVEI 5,20
LPBIT: MOVEM TEMP,DBUF(DBLOC)
AOS DBLOC
SOJG 5,LPBIT
MOVE TEMP,[34070114]
MOVEM TEMP,DBUF(DBLOC)
AOS DBLOC
ADDI LINUM,4
CAIG LINUM,yhi
AOJA DBLOC,LPLIN
ADDI QUAD,1
CAIGE QUAD,4
AOJA DBLOC,LPQUA
ADDI DBLOC,20
MOVEM DBLOC,DDGO+1
JRST @BUFUP
; BITUP MIDI
RMSK: FOR I←0,37,1 { ((-1)⊗(-I))∧(-20)
}
LMSK: FOR I←0,37,1 { ¬(377777777777⊗(-I))∧(-20)
}
BSK: FOR I←0,37,1 { 400000000000 ⊗ (-I)
}
;ROUTINE FOR PLACING A BIT AT (X1,Y1)
BITUP: CAIL Y1,0 ; Make sure y...
CAILE Y1,737
popj p,
CAIL X1,0 ; and x are in range.
CAIL X1,20*40-1
popj p,
MOVE XA,X1
LSH X1,-5 ; Find x div 32 (graphic column address) → x1
ANDI XA,37 ; and x mod 32 (bit position) → xa
MOVE 10,BSK(XA)
ADD X1,SLINE(Y1)
MIDI: ORM 10,DBUF(X1)
popj p,
;HORUP
;HORIZONTAL LINE AT Y1, BETWEEN X1 AND X2
;uses acs x1,y1,x2,10,xa,xb (1,2,3,10,11,13)
HORUPO: CAMLE X1,X2 ;ENTRY POINT FROM OBLUP
EXCH X1,X2
MOVE XA,X1
JRST HORUP1
horup: CAIL Y1,0
CAILE Y1,yhi
popj p,
CAMLE X1,X2
EXCH X1,X2
CAIL X2,0
CAILE X1,XHI
popj p,
SKIPGE XA,X1
SETZB X1,XA
CAILE X2,XHI
MOVEI X2,XHI
HORUP1: MOVE XB,X2
LSH X1,-5
LSH X2,-5
ANDI XA,37
ANDI XB,37
MOVE 10,RMSK(XA)
SUB X2,X1
ADD X1,SLINE(Y1)
JUMPG X2,NOTE
AND 10,LMSK(XB)
XCT MIDI
popj p,
NOTE: XCT MIDI
HRROI 10,777760
LMDL: AOS X1
SOJLE X2,FINE
XCT MIDI ;orm 10,dbuf(x1)
AOJA X1,LMDL+1
FINE: MOVE 10,LMSK(XB)
XCT MIDI
popj p,
;VERUP
;VERTICAL LINE AT X1 BETWEEN Y1 AND Y2
;uses acs x1,y1,x2,y2,xa,10 (1,2,3,4,10,11)
verupo: CAMLE X2,X1 ;entry point for oblup
EXCH X1,X2
JRST VERUP1
verup: CAIL x1,0
CAILE x1,XHI
popj p,
EXCH X1,Y1 ;x and y are flipped for the convenience
EXCH X2,Y2 ;of oblup
camle x2,x1 ;make x2≤x1
exch x1,x2
cail x1,0 ;is max(x1,x2)<0
CAILE x2,YHI ; or min > 737?
POPJ P,
CAIGE X2,0
MOVEI X2,0
CAILE X1,YHI
MOVEI X1,YHI
VERUP1: subm x2,x1 ;x1 ← -abs(x2-x1)
hrli x2,-1(x1)
move xa,y1
andi xa,37 ;number of bit in word (0 to =31)
move 10,bsk(xa)
hrrz xa,y1
lsh xa,-5
add xa,midi
vlp: move x1,sline(x2)
xct xa ;midi + offset
aobjn x2,vlp
popj p,
;OBLUP
;OBLIQUE LINE FROM (X1,Y1) TO (X2,Y2)
;uses acs x1,y1,x2,y2,xa,xb,line,sum,10,delt (1,2,3,4,6,7,10,11,12,13,14,15)
;calls horup,horupo,verup,verupo
delt←6 dind←delt+1 SUM←DIND linetype←12 xt←15
oblup: subm x1,x2
subm y1,y2
jumpe x2,[ subm y1,y2 ↔ jrst verup]
jumpe y2,[ subm x1,x2 ↔ jrst horup]
push p,12
movei linetype,horupo ;this is the routine we draw with
move xa,y2
idivm x2,xa
jumpn xa,dxgr
exch x1,y1
exch x2,y2
movei linetype,verupo
dxgr: jumpl y2,y2neg ; we want y1≤y2
sub y1,y2
movn y2,y2
sub x1,x2
movn x2,x2
y2neg: ;y2 = -abs(y1-y2) y1=min(y1,y2)
skipl xt,x2
addi x2,2
subm x1,xt ;save final value of x
movsi delt,-1(x2)
idiv delt,y2 ;delt ← 1000000*(x2-x1+1)/(ylo-yhi)
hrrz dind,4(linetype) ;gets max value y's should be
hrl y1,y2 ;y1 ← ylo-yhi,,ylo
move sum,delt
ash sum,-1
hrlz xa,x1
add sum,xa ;sum ← delt/2 + 1000000*x1
addi sum,377777 ;rounding constant
hlrz x2,sum
pushj p,(linetype) ;draw the first half linetype
AOBJP Y1,DYGRD
DYGRL: hlrz x1,sum
add sum,delt
hlrz x2,sum
pushj p,(linetype) ;draw the horizontal linetype at y1
AOBJN Y1,DYGRL
dygrd: hlrz x1,sum
move x2,xt
pushj p,(linetype)
pop p,12
popj p,
;RECTUP
RECTUP: 0 ;ROUTINE FOR MAKING A RECTANGLE
CAML Y1,Y2 ;FILLING THE SPACE X1-X2, Y1-Y2
EXCH Y1,Y2
CAIL Y2,0
CAILE Y1,737
JRST @RECTUP
CAIGE Y1,0
MOVEI Y1,0
CAILE Y2,737
MOVEI Y2,737
CAML X1,X2
EXCH X1,X2
CAIL X2,0
CAIL X1,20*40-1
JRST @RECTUP
CAIGE X1,0
MOVEI X1,0
CAIL X2,20*40-1
MOVEI X2,20*40-2
MOVE XA,X1
MOVE XB,X2
LSH X1,-5
LSH X2,-5
ANDI XA,37
ANDI XB,37
MOVE 10,RMSK(XA)
MOVE 6,Y1
MOVE 5,X1
CAME X1,X2
JRST NOTE1
AND 10,LMSK(XB)
YLL: ADD X1,SLINE(Y1)
XCT MIDI
CAIL Y1,(Y2)
JRST @RECTUP
MOVE X1,5
AOJA Y1,YLL
NOTE1: ADD X1,SLINE(Y1)
XCT MIDI
MOVE X1,5
CAIGE Y1,(Y2)
AOJA Y1,NOTE1
MOVE Y1,6
HRROI 10,777760
LMDL1: AOS X1,5
CAML X1,X2
JRST FINE1
YL1: ADD X1,SLINE(Y1)
XCT MIDI
MOVE X1,5
CAIGE Y1,(Y2)
AOJA Y1,YL1
MOVE Y1,6
JRST LMDL1
FINE1: MOVE 10,LMSK(XB)
YL2: ADD X1,SLINE(Y1)
XCT MIDI
CAIL Y1,(Y2)
JRST @RECTUP
MOVE X1,5
AOJA Y1,YL2
;SCREEN SCREEM BEGINNING OF SAIL INTERFACE
DEFINE SAVAC(N)
< IFGE N-12,{MOVEM 12,ACS+12}
IFGE N-16,{MOVEM 16,ACS+16}
IFGE N-17,{MOVEM 17,ACS+17} >
DEFINE RESAC(N)
< IFGE N-12,{MOVE 12,ACS+12}
IFGE N-16,{MOVE 16,ACS+16}
IFGE N-17,{MOVE 17,ACS+17} >
ACS: BLOCK 20
RETAD: 0
XL: 0.0
XH: 1.0
XSC: 510.999
YL: 0.0
YH: 1.0
YSC: -479.999
SCREEN: SAVAC(3) ;SET UP SCREEN DIMENSIONS
POP P,RETAD ;SCREEN(XL,YL,XH,YH)
POP P,YH ;DEFAULT XL=0.0 YH=1.0
POP P,1 ; YL=0.0 YH=1.0
MOVEM 1,XH
POP P,2
MOVEM 2,YL
POP P,XL
FSBR 1,XL
MOVE 3,[511.0]
FDVR 3,1
MOVEM 3,XSC
FSBR 2,YH
MOVE 3,[480.0]
FDVR 3,2
MOVEM 3,YSC
RESAC(3)
JRST @RETAD
SCREEM: POP P,RETAD
POP P,1
MOVE 2,YH
MOVEM 2,(1)
POP P,1
MOVE 2,XH
MOVEM 2,(1)
POP P,1
MOVE 2,YL
MOVEM 2,(1)
POP P,1
MOVE 2,XL
MOVEM 2,(1)
JRST @RETAD
;DOT
DOT: SAVAC(10)
POP P,RETAD
POP P,THK
POP P,Y1
FSBR Y1,YH
FMPR Y1,YSC
FIX Y1,
POP P,X1
FSBR X1,XL
FMPR X1,XSC
FIX X1,
pushj p,BITUP
RESAC(10)
JRST @RETAD
;PPPOS
PPPOS: POP P,RETAD
POP P,Y2
FSBR Y2,YH
FMPR Y2,YSC
FIX Y2,
POP P,Y1
FSBR Y1,YH
FMPR Y1,YSC
FIX Y1,
CAMLE Y1,Y2
EXCH Y1,Y2
SUB Y2,Y1
IDIVI Y2,14
ASH Y2,11
DPYSIZ 1(Y2)
MOVN Y1,Y1
MOVE 0,Y1
ASH 0,-3
ASH Y1,1
ADD Y1,0
ADDI Y1,747
DPYPOS (Y1)
JRST @RETAD
;LINE LINET
;Draw a line From (X1,Y1) TO (X2,Y2)
xsl: 0
xsh: 511.
ysl: 0
ysh: 480.
x1←1 y1←2 x2←3 y2←4 t1←5 t2←6 foo←0 p←17
LINET: FSB X2,X1
FSB Y2,Y1
JRST LINE1
line: params(x1,y1,x2,y2,THK)
fsb x2,x1 ;ENTRY POINT FROM TEXTUP
fmpr x2,xsc
fsb x1,xl
fmpr x1,xsc
fsb y2,y1
fmpr y2,ysc
fsb y1,yh
fmpr y1,ysc
LINE1: setz t1,
pushj p,clip1
fsbri t1,(1.)
movn t2,t1
fad x1,x2
movn x2,x2
fad y1,y2
movn y2,y2
setz t1,
pushj p,clip1
camle t1,t2
popj p, ;return - entirely outside rectangle
fdv t1,t2
fsbri t1,(1.) ;t2←t2/t1-1.
movn t1,t1
fmp x2,t2
fadm x2,x1
fmpr x2,t1 ;x2←x1-x2
fsbm x1,x2
kifix x1,x1
kifix x2,x2
fmp y2,t2
fadm y2,y1
fmpr y2,t1
fsbm y1,y2
kifix y1,y1
kifix y2,y2
jrst oblup
clip1: caml x1,xsl
jrst x1ge
move foo,xsl
fsb foo,x1
fdvr foo,x2
camge t1,foo
move t1,foo
x1ge: camg x1,xsh
jrst x1le
move foo,xsh
fsb foo,x1
fdvr foo,x2
camge t1,foo
move t1,foo
x1le: caml y1,ysl
jrst y1ge
move foo,ysl
fsb foo,y1
fdvr foo,y2
camge t1,foo
move t1,foo
y1ge: camg y1,ysh
jrst y1le
move foo,ysh
fsb foo,y1
fdvr foo,y2
camge t1,foo
move t1,foo
y1le: popj p,
;LITEN DRKEN INVEN DPYUP ERASE DDINIT
;ROUTINE FOR CAUSING SUBSEQUENT OUTPUTS TO APPEAR BRIGHT
LITEN: MOVE 1,[ ORM 10,DBUF(X1)]
MOVEM 1,MIDI
POPJ P,
;ROUTINE FOR CAUSING FURTHER OUTPUTS TO NEGATE PREVIUS DISPLAY
INVEN: MOVE 1,[ XORM 10,DBUF(X1)]
MOVEM 1,MIDI
POPJ P,
;ROUTINE FOR MAKING SUCCEEDING OUTPUTS DARK
DRKEN: MOVE 1,[ ANDCAM 10,DBUF(X1)]
MOVEM 1,MIDI
POPJ P,
DPYUP: SAVAC(3) ;PUT UP DISPLAY ON CHANEL N
POP P,RETAD ; DPYUP(N,BUFFER)
POP P,X1 ;FLAGS,,ADDRESS OF BUFFER
AOJE X1,DPYUP1 ;IF -1 USE MAIN BUFFER
SOSA X1 ;FOR OUTPUT
DPYUP1: MOVEI X1,DBUF
MOVEM X1,DDGO
POP P,X1
JUMPGE X1,VALCHN ;other than own channel specified?
ITSADD: MOVE X1,[-1,,[022000,,X1]] ;line # of controlling terminal
TTYSET X1,
CAME X1,[-1]
TLNN X1,20000
JRST @RETAD ;if not a DD display
MOVEI X2,237 ;get LETAB address
PEEK X2,
ADDI X2,-60(X1) ;offset to get controlling jobs entry
PEEK X2,
MOVEI X1,340 ;a word containing PRGNUM, the
PEEK X1, ;offset into DPYHDR giving DD chan #
ADDI X1,(X2)
PEEK X1,
HLRZ X1,X1 ;fetch ch # from left halfword
VALCHN: MOVE 2,X1 ; Build up a datadisc program word of
ORI 2,40 ; the form:
LSH 2,10 ; <chan> <chan> <chan> 2 2 2 4
OR 2,X1 ; (with the bits in the right place, and
ORI 2,40 ; <chan> being the channel no. or'ed with
LSH 2,10 ; 40 octal). This means "select the
OR 2,X1 ; specified channel"...three times!
ORI 2,40
LSH 2,14
ORI 2,2224
MOVE 3,DDGO
MOVEM 2,1(3)
DDUPG 3,DDGO
RESAC(3)
JRST @RETAD
ersbuf: BYTE (8) 17,40,46 (3) 1,2,1,4 ;funct. code, chan select, funct. code
0
erspt: ersbuf
erspt-ersbuf
0
0
ERASE: move x1,-1(p)
JUMPGE X1,NOTOWN ;check if own channel
MOVEI X1,277
DDCHAN X1,
NOTOWN: pop p,-1(p)
dpb x1,[point 5,ersbuf,15]
ddupg erspt
popj p,
DDINIT: SAVAC(16) ;INITIALIZE THE DATA DISC BUFFER
JSR BUFUP
RESAC(16)
POPJ P,
;GDDCHN RDDCHN
GDDCHN: POP P,RETAD ;GET A NEW DD CHANNEL TO WRITE
POP P,1 ; CHAN#←GDDCHN(CHAN)
ANDI 1,77 ; ON SUCCESS IT RETURNS THE
CAIN 1,77 ; CHANNEL, ON FAILURE -1
JRST ANYCH ; IF ANY CHANNEL WILL DO, THE
MOVE 2,1 ; ARGUMENT SHOULD BE -1
ORI 2,200 ;see if we already have channel
DDCHAN 2,
HLRZ 2,2
ANDI 2,377
PJOB 3,
CAMN 2,3
JRST @RETAD
;CH13F: 13 ;set to -1 when 13 GDDCHN'd, otherwise 13
ANYCH: ORI 1,100
DDCHAN 1,
SETO 1,
; JRST [ MOVE 1,CH13F
; CAIN 1,13
; SETOM CH13F
; JRST @RETAD]
HRRE 1,1
JRST @RETAD
RDDCHN: POP P,RETAD ;TO RELEASE A DD CHANNEL
POP P,1 ; RDDCHN(CHAN)
ANDI 1,77
; CAIN 1,13
; MOVEM 1,CH13F
DDCHAN 1,
JRST @RETAD
;SHOW SHOWA SHOWS
SHOW: MOVE 3,[1000,,2]
MOVEI 1,221 ;SWITCH USER CONSOLE TO A
PEEK 1, ;REQUESTED DD CHANNEL
HLRZ 1,1
MOVE 2,1 ;first extract DPYL0
LSH 2,-9 ;and DDL0 table offset
ANDI 1,777 ;locations from the monitor
ADD 1,2 ; left half of low core 221
MOVN 1,1
MOVN 2,2
HRRM 2,XDPYL0
HRRM 1,XDDL0
POP P,RETAD
POP P,4
POP P,CHN#
JUMPGE 4,NOTME
MOVE 4,[-1,,[022000,,2]] ;line # of controlling terminal
TTYSET 4,
CAME 2,[-1]
TLNN 2,20000
JRST @RETAD ;if not a DD display
HRLZ 2,2
OR 2,[017400,,2]
MOVE 4,[-1,,2] ;line # of responsible
TTYSET 4, ; responsible terminal
MOVEI 4,335 ;get VDTIE table address
PEEK 4,
XDDL0: ADDI 4,-62(2) ;offset to get controlling jobs entry
PEEK 4, ;gets dd line number respons term is tied to
NOTME: andi 4,577
tso 3,4
MOVE 1,CHN
JUMPGE 1,COKS ;if not our own channel
MOVE 1,[-1,,[022000,,1]] ;if it is our terminal, find which channel
TTYSET 1,
CAME 1,[-1]
TLNN 1,20000
JRST @RETAD ;if not a DD display
MOVEI 2,237 ;get LETAB address
PEEK 2,
XDPYL0: ADDI 2,-60(1) ;offset to get controlling jobs entry
PEEK 2,
MOVEI 1,340 ;a word containing PRGNUM, the
PEEK 1, ;offset into DPYHDR giving DD chan #
ADDI 1,(2)
PEEK 1,
HLRZ 1,1 ;fetch ch # from left halfword
COKS: CAIGE 1,40
JRST NOTANA
ANDI 1,17
MOVE 2,1
JRST DUP
NOTANA: MOVN 1,1
HRLZI 2,400000
LSH 2,(1)
DUP: VDSMAP 3,
JRST .+1
JRST @RETAD
SHOWA: MOVE 3,[2000,,2] ;ADD A GIVEN DD TO USER CONSOLE
JRST SHOW+1 ; SHOWA(CHAN)
SHOWS: MOVE 3,[3000,,2] ;SUBTRACT A GIVEN DD CHAN
JRST SHOW+1 ; SHOWA(CHAN)
;LINSCH SCNOFF
DOLT: 1
MSIZ: 0
MLOC: 0
TTYN: 41
MPOS: 0
HIGHDT: 1
HIGHCN: 0
GETTV: XWD 17000,1
LINSCN: POP P,RETAD ;DISPLAY IN RAPID SUCCESSION
POP P,1
JUMPGE 1,OTHTV
MOVE 2,[XWD -1,GETTV] ;(DT TICKS/CHAN) THE CHANNELS
TTYSET 2,
OTHTV: SUBI 1,60 ;INDICATED IN THE ARRAY MAP
HRRZM 1,TTYN ;STARTING OVER AFTER N OF THEM
POP P,2
MOVEI 1,20
REDU: SUBI 1,1
MOVE 3,2 ;LITTLE HACK FOR DT'S GRTR THAN 17
IDIV 3,1
JUMPN 4,REDU
MOVEM 3,HIGHDT
SETZM HIGHCN
POP P,MLOC
POP P,MSIZ
ORI 1,400000
HRLZ 1,1
ORI 1,SPWLIN ;SPWLIN
CALLI 1,400003
JRST @RETAD
MAPSCN: POP P,RETAD ;DISPLAY IN RAPID SUCCESSION
POP P,1 ;table contains raw VDS maps
JUMPGE 1,OTHTVM
MOVE 2,[XWD -1,GETTV]
TTYSET 2,
OTHTVM: SUBI 1,60 ;INDICATED IN THE ARRAY MAP
HRRZM 1,TTYN ;STARTING OVER AFTER N OF THEM
POP P,2
MOVEI 1,20
REDUM: SUBI 1,1
MOVE 3,2 ;LITTLE HACK FOR DT'S GRTR THAN 17
IDIV 3,1
JUMPN 4,REDUM
MOVEM 3,HIGHDT
SETZM HIGHCN
POP P,MLOC
POP P,MSIZ
ORI 1,400000
HRLZ 1,1
ORI 1,SPWMAP ;SPWMAP
CALLI 1,400003
JRST @RETAD
SCNFRZ: SPCWAR 636367
POPJ P,
SCNOFF: SPCWAR 636367 ;TURN OFF THE DISPLAY
MOVE 1,[404000,,0]
VDSMAP 1,
JRST .+1
POPJ P,
SCNINC: POP P,RETAD
POP P,DOLT
JRST @RETAD
SPWLIN: SOSLE HIGHCN
CALLI 400024
MOVE 1,HIGHDT
MOVEM 1,HIGHCN
MOVE 1,MPOS ;THE SPACEWAR MODULE
ADD 1,DOLT
CAMGE 1,MSIZ
JRST TSG
SUB 1,MSIZ
JRST .-3
TSG: JUMPGE 1,DOTT
ADD 1,MSIZ
JRST .-2
DOTT: MOVEM 1,MPOS
ADD 1,MLOC
MOVN 1,(1)
HRLZI 2,400000
LSH 2,(1)
MOVE 3,TTYN
HRRM 3,.+1
CONO 340,0
DATAO 340,2
CALLI 400024
SPWMAP: SOSLE HIGHCN
CALLI 400024
MOVE 1,HIGHDT
MOVEM 1,HIGHCN
MOVE 1,MPOS ;THE SPACEWAR MODULE
ADD 1,DOLT
CAMGE 1,MSIZ
JRST TSGM
SUB 1,MSIZ
JRST .-3
TSGM: JUMPGE 1,DOTTM
ADD 1,MSIZ
JRST .-2
DOTTM: MOVEM 1,MPOS
ADD 1,MLOC
MOVE 2,(1)
MOVE 3,TTYN
HRRM 3,.+1
CONO 340,0
DATAO 340,2
CALLI 400024
;RECTAN
RECTAN: SAVAC(13) ;FILL IN THE RECTANGLE BETWEEN
POP P,RETAD ;X1 AND X2 AND Y1 AND Y2
POP P,Y2 ; RECTAN(X1,Y1,X2,Y2)
FSBR Y2,YH
FMPR Y2,YSC
FIX Y2,
POP P,X2
FSBR X2,XL
FMPR X2,XSC
FIX X2,
POP P,Y1
FSBR Y1,YH
FMPR Y1,YSC
FIX Y1,
POP P,X1
FSBR X1,XL
FMPR X1,XSC
FIX X1,
JSR RECTUP
RESAC(13)
JRST @RETAD
;ELLIPS
ELLIPS: ;FILL IN THE ELLIPSE BOUNDED
POP P,RETAD ;BY X1 AND X2 AND Y1 AND Y2
POP P,Y2 ;AND ORIENTED PARALELL TO THE
FSBR Y2,YH ;MAIN AXES
FMPR Y2,YSC ;ELLIPS(X1,Y1,X2,Y2);
FIX Y2,
POP P,X2
FSBR X2,XL
FMPR X2,XSC
FIX X2,
POP P,Y1
FSBR Y1,YH
FMPR Y1,YSC
FIX Y1,
POP P,X1
FSBR X1,XL
FMPR X1,XSC
FIX X1,
XC←←0 ↔ B←←X←←5 ↔ C←←XX←←6 ↔ Y←←7 ↔ H←←14 ↔ W←←15
CAMLE Y1,Y2
EXCH Y1,Y2
MOVE H,Y2
ADDI H,1
SUB H,Y1
MOVE Y,H
SUBI Y,1
FLOAT (Y)
FLOAT (H)
FMPR H,H
CAMLE X1,X2
EXCH X1,X2
MOVE W,X2
SUB W,X1
FLOAT (W)
FMPR W,W
MOVE XC,X1
ADD XC,X2
ELOOP: MOVE X,H
MOVE XB,Y
FMPR XB,XB
FSBR X,XB
FMPR X,W
FDVR X,H
SQRT: ASHC B,-33
SUBI B,201
ROT B,-1
PUSH P,B
LSH B,-43
ASH C,-10
FSC C,177(B)
MOVEM C,1(P) ;FORTRAN SQRT ROUTINE
FMP C,SQ1(B)
FAD C,SQ2(B)
MOVE B,1(P)
FDV B,C
FAD C,B
FSC C,-1
MOVE B,1(P)
FDV B,C
FADR B,C
POP P,C
FSC B,(C)
FIX X,
MOVE X1,XC
MOVE X2,XC
SUB X1,X
ADD X2,X
ADDI X2,1
ASH X2,-1
ASH X1,-1
pushj p,HORUP
FSBR Y,[2.0]
CAMGE Y1,Y2
AOJA Y1,ELOOP
JRST @RETAD
SQ1: 0.8125 ;CONSTANTS FOR SQRT ROUTINE
0.578125
SQ2: 0.302734
0.421875
;DDOR DDAND DDEXCH
DDOR: POP P,RETAD ;ORS ANOTHER DD BUFFER INTO
POP P,1 ;THE MAIN ONE
ADD 1,[MOVE 0,0(5)] ; DDOR(OTHERBUFFER)
MOVE 2,[ORM 0,DBUF(5)]
MOVE 3,[SOJGE 5,1]
MOVE 4,[JRST @RETAD]
MOVEI 5,22*yhi+51
JRST 1
DDAND: POP P,RETAD ;ANDS ANOTHER DD BUFFER INTO
POP P,1 ;THE MAIN ONE
ADD 1,[MOVE 0,0(5)] ; DDAND(OTHERBUFFER)
MOVE 2,[ANDM 0,DBUF(5)]
MOVE 3,[SOJGE 5,1]
MOVE 4,[JRST @RETAD]
MOVEI 5,22*yhi+51
JRST 1
DDEXCH: POP P,RETAD ;EXCHANGES A DD BUFFER WITH
POP P,2 ;THE MAIN ONE
MOVE 1,[MOVE 0,DBUF(6)] ; DDEXCH(OTHERBUFFER)
ADD 2,[EXCH 0,0(6)]
MOVE 3,[MOVEM 0,DBUF(6)]
MOVE 4,[SOJGE 6,1]
MOVE 5,[JRST @RETAD]
MOVEI 6,22*yhi+51
JRST 1
prgend
TITLE XGPUP ;converts the DD buffer into XGP format and
;sends it to the XGP
ENTRY XGPUP
EXTERN CORGET,CORREL
EXTERN SLINE,DBUF
THIS←←2 SIZ←←3
A←1 B←4 C←5 D←6 E←7 F←10 G←11 H←12
RETAD: 0
SAV12: 0
WO: -741*20-741,,0
0
XGPUP: POP 17,RETAD
POP 17,G
CAMN G,[-5]
JRST BIGMID
CAMN G,[-4]
JRST SIDMID
jumpl g,packed
CAIN G,1
JRST SMAL
CAIN G,2
JRST BIG
CAIN G,3
JRST BIGER
CAIN G,4
JRST BIGEST
CAIN G,5
JRST BIGFAT
;SMAL
SMAL: MOVEI SIZ,741
IMULI SIZ,20+1
ADDI SIZ,3
MOVN A,SIZ
HRLZM A,WO
PUSHJ 17,CORGET
JRST [OUTSTR [ASCIZ \RAN OUT OF MEMORY
\]
JRST @RETAD]
SUBI THIS,1
HRRM THIS,WO
PUSH THIS,[400000,,0]
PUSH THIS,[020000,,0]
HRLZI A,-741
YLP: MOVE B,SLINE(A)
ADDI B,DBUF
PUSH THIS,[111,,000020]
HRLI B,-20
XLP: MOVE C,(B)
LSH C,-4
MOVE D,C
ANDCMI D,377
ADDB C,D
ANDCMI D,377777
ADDB C,D
ANDCM D,[377,,777777]
ADD C,D
MOVE D,C
TRNE A,1
JRST ODD
EVEN: AND D,[200200,,200200]
LSH D,1
JRST EO
ODD: AND D,[001001,,001001]
LSH C,1
EO: OR C,D
PUSH THIS,C
AOBJN B,XLP
AOBJN A,YLP
JRST FINSH
;BIG
BIG: MOVEI SIZ,741
IMULI SIZ,40+1
ADDI SIZ,3
MOVN A,SIZ
HRLZM A,WO
PUSHJ 17,CORGET
JRST [OUTSTR [ASCIZ \RAN OUT OF MEMORY
\]
JRST @RETAD]
SUBI THIS,1
HRRM THIS,WO
PUSH THIS,[400000,,0]
PUSH THIS,[020000,,0]
HRLZI A,-741
YLPB: MOVE B,SLINE(A)
ADDI B,DBUF
PUSH THIS,[204,,400040]
HRLI B,-20
XLPB: MOVE D,(B)
LSH D,-2
HLRZ C,D
HRRZ D,D
LSH D,-2
MOVE E,C
MOVE F,D
ANDI C,377
ANDI D,377
ANDI E,177400
ANDI F,177400
LSHC E,=10
IORB C,E
IORB D,F
AND C,[17,,17]
AND D,[17,,17]
AND E,[360,,360]
AND F,[360,,360]
LSHC E,5
IORB C,E
IORB D,F
AND C,[003003,,003003]
AND D,[003003,,003003]
AND E,[014014,,014014]
AND F,[014014,,014014]
TRNE A,1
JRST BODD
BEVEN: LSHC E,3
IORB C,E
IORB D,F
AND C,[041041,,041041]
AND D,[041041,,041041]
AND E,[102102,,102102]
AND F,[102102,,102102]
LSHC E,1
IORB C,E
IORB D,F
LSHC E,1
IOR C,E
IOR D,F
AND E,[010010,,010010]
AND F,[010010,,010010]
JRST BOE
BODD: LSHC E,2
IORB C,E
IORB D,F
AND C,[021021,,021021]
AND D,[021021,,021021]
AND E,[042042,,042042]
AND F,[042042,,042042]
LSHC E,1
IORB C,E
IORB D,F
LSHC E,1
IOR C,E
IOR D,F
AND E,[200200,,200200]
AND F,[200200,,200200]
BOE: LSHC E,1
IOR C,E
IOR D,F
PUSH THIS,C
PUSH THIS,D
AOBJN B,XLPB
AOBJN A,YLPB
JRST FINSH
;BIGER
BIGER: MOVEI SIZ,741
IMULI SIZ,60+1
ADDI SIZ,3
MOVN A,SIZ
HRLZM A,WO
PUSHJ 17,CORGET
JRST [OUTSTR [ASCIZ \RAN OUT OF MEMORY
\]
JRST @RETAD]
SUBI THIS,1
HRRM THIS,WO
MOVEM 12,SAV12
PUSH THIS,[400000,,0]
PUSH THIS,[020000,,0]
HRLZI A,-741
YLPC: MOVE B,SLINE(A)
ADDI B,DBUF
PUSH THIS,[300,,000060]
HRLI B,-20
XLPC: MOVE C,(B)
LSHC C,-=26
LSHC D,-=25
LSH E,-=25
LSHC C,2
LSH D,-1
MOVE F,C
MOVE G,D
MOVE H,E
ANDI C,174
ANDI D,76
ANDI E,37
ANDI F,7600
ANDI G,7700
ANDI H,3740
LSH F,=12
LSHC G,=12
IORB C,F
IORB D,G
IORB E,H
AND C,[000016,,000034]
AND D,[000007,,000016]
AND E,[000003,,400007]
AND F,[000060,,000140]
AND G,[000070,,000060]
AND H,[000034,,000030]
LSHC F,7
LSH H,7
IORB C,F
IORB D,G
IORB E,H
AND C,[004002,,010004]
AND D,[002001,,004002]
AND E,[001000,,402001]
AND F,[010014,,020030]
AND G,[014006,,010014]
AND H,[006003,,004006]
LSHC F,2
LSH H,2
IORB C,F
IORB D,G
IORB E,H
ANDI F,100000
ADDB C,F
AND C,[044022,,210044]
AND D,[022011,,044022]
AND E,[011004,,422011]
AND F,[000040,,000100]
AND G,[040020,,000040]
AND H,[020010,,000020]
LSHC F,3
LSH H,2
MOVE 0,H
AND 0,[100000,,000100]
ADD H,0
IORB C,F
IORB D,G
IORB E,H
LSHC F,1
LSH H,1
IOR C,F
IOR D,G
IOR E,H
LSH F,1
LSHC G,1
IOR C,F
IOR D,G
IOR E,H
AND F,[200100,,040200]
AND G,[100040,,200100]
AND H,[040200,,100040]
LSH F,1
LSHC G,1
IOR C,F
IOR D,G
IOR E,H
PUSH THIS,C
PUSH THIS,D
PUSH THIS,E
AOBJN B,XLPC
AOBJN A,YLPC
MOVE 12,SAV12
JRST FINSH
;BIGEST
BIGEST: MOVE C,[402,,100051]
JRST BIGSTP
SIDMID: MOVE C,[302,,100051]
BIGSTP: MOVEI SIZ,1000
IMULI SIZ,=41+1
ADDI SIZ,3
MOVN A,SIZ
HRLZM A,WO
PUSHJ 17,CORGET
JRST [OUTSTR [ASCIZ \RAN OUT OF MEMORY
\]
JRST @RETAD]
SETZM (THIS)
HRLZ A,THIS
HRRI A,1(THIS)
MOVE B,THIS
ADDI B,-1(SIZ)
BLT A,(B)
SUBI THIS,1
HRRM THIS,WO
PUSH THIS,[400000,,0]
PUSH THIS,[007300,,0]
MOVEI A,1000
CWP: PUSH THIS,C
ADDI THIS,=41
SOJG A,CWP
PUSH THIS,[412700,,0]
SUBI THIS,1000*=42-1
HRRZI A,740
HRLZI D,700000
YLPD: MOVE B,SLINE(A)
ADDI B,DBUF
MOVE E,THIS
HRLI B,-20
XLPD: MOVE C,(B)
MOVEI F,40
BLOOP: TLNE C,400000
ORM D,(E)
LSH C,1
ADDI E,=42
SOJG F,BLOOP
AOBJN B,XLPD
LSH D,-3
JUMPN D,STILL
HRLZI D,700000
ADDI THIS,1
STILL: SOJGE A,YLPD
JRST FINSH1
;BIGFAT
BIGFAT: MOVEI A,700000
JRST BIGG
BIGMID: MOVEI A,600000
BIGG: HRRM A,IX1
HRRM A,IX2
MOVEI SIZ,2000
IMULI SIZ,=41+1
ADDI SIZ,3
MOVN A,SIZ
HRLZM A,WO
PUSHJ 17,CORGET
JRST [OUTSTR [ASCIZ \RAN OUT OF MEMORY
\]
JRST @RETAD]
SETZM (THIS)
HRLZ A,THIS
HRRI A,1(THIS)
MOVE B,THIS
ADDI B,-1(SIZ)
BLT A,(B)
SUBI THIS,1
HRRM THIS,WO
PUSH THIS,[400000,,0]
PUSH THIS,[007300,,0]
MOVEI A,2000
CWPE: PUSH THIS,[202,,100051]
ADDI THIS,=41
SOJG A,CWPE
PUSH THIS,[412700,,0]
SUBI THIS,2000*=42-1
HRRZI A,740
IX1: HRLZI D,700000
YLPE: MOVE B,SLINE(A)
ADDI B,DBUF
MOVE E,THIS
HRLI B,-20
XLPE: MOVE C,(B)
MOVEI F,40
BLOOE: JUMPGE C,.+3
ORM D,(E)
ORM D,=42(E)
LSH C,1
ADDI E,=84
SOJG F,BLOOE
AOBJN B,XLPE
LSH D,-3
JUMPN D,STILE
IX2: HRLZI D,700000
ADDI THIS,1
STILE: SOJGE A,YLPE
JRST FINSH1
;PACKED
packed: addi g,1
movn g,g
caile g,2
movei g,2
hrlzi a,-100
setz b,
setz c,
pkh1: movem b,pktabl(a)
addi c,1
add c,pkstup(g)
andcm c,pkstup(g)
move b,pkmul(g)
imul b,c
aobjn a,pkh1
MOVe siz,pksize(g)
movn a,siz
HRLZM A,WO
PUSHJ 17,CORGET
JRST [OUTSTR [ASCIZ \RAN OUT OF MEMORY
\]
JRST @RETAD]
SUBI THIS,1
HRRM THIS,WO
PUSH THIS,[400000,,0]
PUSH THIS,[020000,,0]
HRLZI A,-741-1
pky: MOVE B,SLINE(A)
aobjp a,finsh
ADDI B,DBUF
hrli b,-20+1
PUSH THIS,pkgcw(g)
addi this,1
hll this,pkbyte(g)
pkx: MOVE C,(B)
andcmi c,17
for i←1,5,1{
setz d,
rotc c,6
move d,pktabl(d)
idpb d,this}
aobjp b,[setzm (this)
dpb d,this
setz d,
rotc c,6
move d,pktabl(d)
idpb d,this
jrst pky]
move d,(b)
andcmi d,17
lsh d,-2
ior c,d
for i←1,5,1{
setz d,
rotc c,6
move d,pktabl(d)
idpb d,this}
move d,1(b)
lsh d,-4
ior c,d
for i←1,6,1{
setz d,
rotc c,6
move d,pktabl(d)
idpb d,this}
add b,[2,,2]
jrst pkx
pktabl: block 100
pkbyte: point 6,0
point 12,0
point 18,0
pkgcw: 111,,17
205,,000035
301,,000053
pksize: 741*20+3
741*36+3
741*54+3
pkstup: 0
525252
666666
pkmul: 1
3
7
FINSH: PUSH THIS,[424000,,0]
FINSH1: CHNSTS 1,A
JUMPE A,.+3
IOPUSH 1,1
JRST [OUTSTR [ASCIZ \ Can't do IOPUSH for XGP \]
JRST @RETAD]
INIT 1,617 ;automatic return if xgp not availible
SIXBIT /XGP/
0
JRST NOXG ;not available
JRST XGAV
NOXG: OUTSTR [ASCIZ / Waiting for XGP
/]
init 1,1217 ;automatic wait for device
sixbit /xgp/
0
JRST [OUTSTR [ASCIZ \ XGP trouble (INIT) \]
JRST OUTOK]
XGAV: OUT 1,WO
JRST OUTOK
OUTSTR [OUTPUT [ASCIZ \ XGP error \]]
OUTOK: RELEAS 1,
JUMPE A,.+3
IOPOP 1,1
JRST .+1
HRRZ THIS,WO
ADDI THIS,1
PUSHJ 17,CORREL
JRST @RETAD
prgend
title synmap
entry synmap,mapset,ORDTAB,chkini
extern corget,correl
search stuff
tac←0 ↔ a←1 ↔ b←2 ↔ c←3 ↔ d←4 ↔ e←5 ↔ f←6 ↔ g←7
ord←10 ↔ reset←11
p←17
ddwrite←←200000 ;ddchan uuo write permission bit
getchn←←100 ;ddchan uuo get channel function
synchan←←8 ;there are currently 8 synthesizor channels
lch←←12 ;io channel to look up synth lock out file
magic←←=54 ;you need to know this to use the synth when its
;locked out.
0
ini0:
chans: repeat synchan,{-1} ;chans[i] is the dd chan for syn bit i
lokflg: -1
ini1:
loknam: sixbit /synth/ ;if this file exists then only special programs
sixbit /lok/ ;can use the video synthesizor
0
sixbit /tmphpm/
loknm2: block 4
ordtab: 33 ↔ 32 ↔ 31 ↔ 30 ;table to swap chans around when one goes bad
35 ↔ 36 ↔ 37 ↔ 34 ;1st entry is high order chan. etc.
cpopj: popj p,
; a←permut(b) where b = the intensity value coming into the map and a = the
; intensity value which this signifies to the program, i.e. it ignores
; channels we don't have and maybe swaps their value around.
; chkchn assumes that location permut + 2*i is a word which set the intensity bit
; in A corresponding to dd chan. 40-i . Hence if cables get moved this table
; will have to be changed.
permut:
setz a,
trne b,200 ;dd ch. 37 as long as it stays the way we wired it
iori a, ;
trne b,100 ;36
iori a,
trne b,40 ;etc.
iori a,
trne b,20
iori a,
trne b,10
iori a,
trne b,4
iori a,
trne b,2
iori a,
trne b,1
iori a,
popj p,
chkini: setzm chans-1 ;set number of channels zero
setom ini0
move a,[ini0,,ini0+1]
blt a,ini1-1 ;initialize some storage
popj p,
chkchn: ;reserve the available synthesizor chans
;and set up the permute function
movm a,reset
caie a,magic ;always allow him to use the synth.
skiple lokflg
jrst chkch0
skipl lokflg
jumpe reset,cpopj
; pushj p,getchan↑ ;call sails getchan
; jumpl a,cpopj
iopush lch,
halt .
init lch,0
sixbit /dsk/
0,,0
halt .
move b,[loknam,,loknm2]
blt b,loknm2+3
setzb b,lokflg
lookup lch,loknm2
aos b,lokflg
release lch,
iopop lch,
cai
jumpe b,cpopj
chkch0: movei a,1
movem a,lokflg
jumpl reset,setit ;if reset then force getting channels
skipl chans ;chans[0] will be -1 if it hasn't been set
popj p, ;array chans already set - go away
setit: hrlzi a,-synchan ;aobjn counter for number of syn channels
hrlzi c,<iori a,> ⊗ -=18 ;set up to make permute function
movei d,1 ⊗ (synchan-1) ;1st bit to set in permute function
setz f, ;f is the number of free channels found
movni g,1 ; -1 to store into chans[a]
getlp: movem g,chans(a) ;chans[a] ← -1
hllz c,c ;zero the permute bit
move b,[ddwrite,,getchn] ;set up for ddchan uuo, chan with write permission
ior b,ordtab(a) ;get the channel for the i'th highest bit
ddchan b,
tlne b,ddwrite ;see if we can write on it
skipa
jrst notav ;nope
ior c,d ;permute bit i → bit f
move b,ordtab(a) ;chan # again
movem b,chans(f) ;since we got it, store it in array
aos f ;bump f
lsh d,-1 ;next lower order bit for permute fcn.
notav: movn b,ordtab(a) ; - chan #
lsh b,1 ; e ← -2*chan. # ( = 2*(40-chan#)-100 )
movem c,permut+100(b) ;set permute function
aobjn a,getlp
movem f,chans-1 ;total number of syn channels we got
popj p,
;synmap
;integer procedure synmap(integer ord,reset(0) );
; returns chans[ abs(ord) ] , setting up array chans if needed
synmap: params(ord,reset)
pushj p,chkchn ;set up array chans if neccesary
movm ord,ord
movni a,1 ;default is -1
caige ord,synchan ;ord too big - not that many bits
move a,chans(ord)
popj p,
;vitout
elf←470
logmapsiz←←8
mapsiz←←1 ⊗ logmapsiz
mapadr←←771000⊗-1
vitout:
params(b) ;iowd of block to be output
seto a, ;assume success unless otherwise noted
eiotm
movei c,write!doit!twowd
soj b, ;make b into an iowd
hrli b,-(mapsiz ⊗ -1) ;and size of block is mapsiz/2
coni elf,d ;save state for later
cono elf,setadr!mapadr
cono elf,(c)
v1: blko elf,b
jrst cleanu ;done outputting block, cleanup
consz elf,nxm11!busto
jrst fixit
v2: consz elf,busy
jrst v2 ;not done with last one
jrst v1
fixit: setz a, ;supposed to fix up interface but
;haven't done it
;attempt to put interface back as it was
cleanu: hlrz b,d ;previous unibus address
iori b,400000
cono elf,clrint!stopit!ireset
cono elf,(b) ;restore previous address
andi d,1777
cono elf,(d) ;restore previous mode,interupt chan etc.
seto a,
liotm(cpopj) ;leave iot mode and return
;mapset
;boolean procdure mapset(real procedure f;integer reset(0) )
vitdat: 1,,0
pnt: point 18,0 ;half word pointer for data
mapset: params(a,reset)
hrrm a,m3 ;address of function call
pushj p,chkchn
skipg lokflg ;if lokflg≤0 then exit
popj p,
movei c,mapsiz
lsh c,-1 ;packed 2 pdp11 words per halfword
pushj p,corget
halt
hrrm b,vitdat ;address of table of data
movsi c,<point 18,0>⊗-=18
movem c,pnt
hrrm b,pnt ;halfword pointer to table
seto b,
pushj p,permut ;max grey value
fsc A,233-logmapsiz
MOVEM A,SCA#
hrlzi b,-mapsiz
m1: pushj p,permut ;a ← permut(b)
fsc a,233-logmapsiz ;float a
PUSH P,B
push p,a
m3: pushj p,0
fdvr a,sca ;scale the intensity value
; kafix a,(233-logmapsiz)⊗ 9
fsc a,logmapsiz
kifix a,a
caige a,0
movei a,0
caile a,mapsiz-1
movei a,mapsiz-1
pop p,b
idpb a,pnt
aobjn b,m1
push p,vitdat ;beginning of table of data
pushj p,vitout ;output block at elfwd
push p,a
hrrz b,vitdat
pushj p,correl
pop p,a
popj p,
PRGEND
;PJUP
title pjup
entry pjup
search stuff
extern sline,dbuf
a←1 ↔ b←2 ↔ c←3 ↔ d←4 ↔ e←5 ↔ f←6 ↔ p←17
elf←470
alufun←←677776⊗-1
evenadr←600000⊗-1
oddadr←640000⊗-1
ddlo←=13 ↔ ddhi←=466 ;difference should be the y size of jarvis term
cpopj: popj p,
pjup:
eiotm
coni elf,f ;store state for later
cono elf,write!onewd!grab!doit!ireset
cono elf,setadr!alufun
datao elf,[12] ;alu function is just image write
cono elf,write!twowdl!grab!doit ;2 11 words per 10 word left adjusted
cono elf,setadr!evenadr
movei e,-1+dbuf
movei c,ddlo
v7: hrlzi d,-((ddhi+1-ddlo)⊗-1)
v6:
move b,e
add b,sline(c)
hrli b,-=16 ;b← iowd data disk words per line,line
datao elf,[0] ;jarvis terminal is wider
v1: blko elf,b
jrst v5 ;done outputting block
consz elf,nxm11!busto
jrst lose
v2: consz elf,busy
jrst v2 ;not done with last one
jrst v1
v5: CONSZ ELF,BUSY
JRST V5
datao elf,[0] ;in fact its two wider than the data disk
addi c,2
aobjn d,v6
ife ddlo&1,<
trne c,1 ;if c is odd then we are done>
ifn ddlo&1,<
trnn c,1 ;if c is even then we are done>
jrst vdone
cono elf,setadr!oddadr
movei c,ddlo+1
jrst v7
lose: setz a,
vdone: hlrz b,f ;previous unibus address
iori b,400000
cono elf,clrint+stopit!ireset
cono elf,(b) ;restore previous address
andi f,1777
cono elf,(f) ;restore previous mode,interupt chan etc.
liotm(cpopj) ;leave iot mode and return
prgend
TITLE DDPAK
; DDPAK(I,BUFFER) packs scanline I of the DD buffer into array BUFFER,
; 36 bits per word
ENTRY DDPAK
EXTERN DBUF,SLINE
P←17 ↔ I←1 ↔ BUF←2 ↔ B←3 ↔ C←4 ↔ L←5 ↔ LL←6 ↔ H←7 ↔ HH←10
BB←11
RETAD: 0
DDPAK: POP P,RETAD
POP P,H
POP P,L
POP P,BUF
MOVE BB,BUF
POP P,I
CAIL I,0
CAILE I,=480
JRST @RETAD
CAMLE L,H
EXCH L,H
CAIGE L,0
MOVEI L,0
CAILE H,777
MOVEI H,777
CAMLE L,H
JRST @RETAD
IDIVI L,40
IDIVI H,40
MOVE B,SLINE(I)
ADDI B,DBUF-1(L)
HRLI B,400
SUBI BUF,1
HRLI BUF,400
MOVEI C,1(H)
SUBI C,(L)
UPL: ILDB 0,B
IDPB 0,BUF
ILDB 0,B
IDPB 0,BUF
ILDB 0,B
IDPB 0,BUF
ILDB 0,B
IDPB 0,BUF
ILDB 0,B
IDPB 0,BUF
ILDB 0,B
IDPB 0,BUF
ILDB 0,B
IDPB 0,BUF
ILDB 0,B
IDPB 0,BUF
IBP B
SOJG C,UPL
CAIN LL,0
JRST @RETAD
MOVE 0,(BB)
LSH 0,(LL)
MOVEM 0,(BB)
ADDI BB,1
MOVEI C,(H)
SUBI C,(L)
SHLOOP: SOJL C,@RETAD
MOVE HH,(BB)
MOVEI H,0
LSHC H,(LL)
ORM H,-1(BB)
MOVEM HH,(BB)
AOJA BB,SHLOOP
END